module TP1
( fAst
, gAst
, aplicando
, cambiarAE
, cambiarGatoPorLiebre
, mapearNumerosALetras
, intercambiarConsecutivos
, acumularAes
, espejarEntreAes
, comp
, salidaAes
, salidaPosible
) where

import Prelude
import Data.List

-- El traductor se representa por un conjunto de estados "q",
--   - una funcion de transicion (primer parametro),
--   - una funcion de output (segundo parametro) y
--   - un estado inicial.
type Traductor q = (q -> Char -> q, q -> Char -> String, q)

-- Traductor que cambia las "a"s por "e"s y viceversa.
cambiarAE :: Traductor ()
cambiarAE = (const, g, ())
  where
    g :: () -> Char -> String
    g _ 'a' = "e"
    g _ 'e' = "a"
    g _  x  = [x]

-- Traductor que cambia "gato" por "liebre".
cambiarGatoPorLiebre :: Traductor String
cambiarGatoPorLiebre = (f, g, "")
  where
    f :: String -> Char -> String
    f "" 'g'    = "g"
    f "g" 'a'   = "ga"
    f "g" _     = ""
    f "ga" 't'  = "gat"
    f "ga" _    = ""
    f "gat" 'o' = ""
    f "gat" _   = ""
    f x _       = x
    g :: String -> Char -> String
    g "" 'g'    = ""
    g "g" 'a'   = ""
    g "g" c     = "g" ++ [c]
    g "ga" 't'  = ""
    g "ga" c    = "ga" ++ [c]
    g "gat" 'o' = "liebre"
    g "gat" c   = "gat" ++ [c]
    g _ c       = [c]

-- Traductor que modifica los caracteres que son numeros por
-- letras, empezando por la 'a' para el 0, la 'b' para el 1, etc.
mapearNumerosALetras :: Traductor ()
mapearNumerosALetras = (const, g, ())
  where
    g :: () -> Char -> String
    g _ '0' = "a"
    g _ '1' = "b"
    g _ '2' = "c"
    g _ '3' = "d"
    g _ '4' = "e"
    g _ '5' = "f"
    g _ '6' = "g"
    g _ '7' = "h"
    g _ '8' = "i"
    g _ '9' = "j"
    g _ x   = [x]

-- Traductor que intercambia caracteres consecutivos.
intercambiarConsecutivos :: Traductor (Maybe Char)
intercambiarConsecutivos = (f, g, Nothing)
  where
    f :: (Maybe Char) -> Char -> (Maybe Char)
    f Nothing caracter = (Just caracter)
    f (Just caracter) c = Nothing
    --
    g :: (Maybe Char) -> Char -> String
    g Nothing caracter = ""
    g (Just caracter) c = c:caracter:[]

-- Traductor que sea la identidad, salvo que nunca genera
-- salida output de las "a"s y, cuando aparece una "z",
-- muestra la "z" y luego todas las "a"s que se acumularon
-- juntas.
acumularAes :: Traductor Int
acumularAes = (f, g, 0)
  where
    f :: Int -> Char -> Int
    f x 'a' = x + 1
    f _ 'z' = 0
    f x  _  = x
    --
    g :: Int -> Char -> String
    g x 'z' = 'z':(replicate x 'a')
    g _ 'a' = [ ]
    g _  c  = [c]

-- Traductor que de vuelta (ie. espeje) todo lo que esta
-- entre dos "a"s consecutivas.
espejarEntreAes :: Traductor String
espejarEntreAes = (f, g, "")
  where
    f :: String -> Char -> String
    f _ 'a' = []
    f q  c  =  q ++ [c]
    --
    g :: String -> Char -> String
    g q 'a' = (reverse q) ++ "a"
    g _  _  = []

-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version recursiva explicita).
fAst' :: (q -> Char -> q) -> q -> String -> q
fAst' f q0 ""     = q0
fAst' f q0 (c:cs) = fAst' f (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de
-- transicion pasada como parametro
-- (version con esquemas de recursion).
fAst :: (q -> Char -> q) -> q -> String -> q
fAst f q0 = foldl' f q0

-- Calcular la clausura de Kleene de la funcion de
-- salida pasada como parametro junto con la funcion
-- de transicion pasada como parametro
-- (version recursiva explicita).
gAst' :: (q -> Char -> q) -> (q -> Char -> String) ->
         q -> String -> String
gAst' f g q0 ""     = ""
gAst' f g q0 (c:cs) = (g q0 c) ++ gAst' f g (f q0 c) cs

-- Calcular la clausura de Kleene de la funcion de
-- salida pasada como parametro junto con la funcion
-- de transicion pasada como parametro
-- (version con esquemas de recursion).
gAst :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> String
gAst f g q0 ss = foldr (++) [] (salidas f g q0 ss)

prefijos                   :: [a] -> [[a]]
prefijos                =  foldr (\x rec -> [[]] ++ map (x:) rec) [[]] 

-- devuelve las salidas desde i al infinito partiendo del estado q0 y usando f y g
salidas :: (q -> Char -> q) -> (q -> Char -> String) -> q -> String -> [String]
salidas f g q0 ss =  zipWith g (estados f q0 ss) ss

-- devuelve los estados desde i al infinito partiendo del estado q0 y usando f como funcion de transicion
estados :: (q -> Char -> q) -> q -> String -> [q]
estados f q0 ss = foldr (\x rec -> (fAst f q0 x): rec) [] (prefijos ss)

-- Dado un traductor, retornar la funcion String -> String
-- que resulta al aplicarlo a cualquier entrada
aplicando :: Traductor q -> String -> String
aplicando (f, g, q) = gAst f g q

-- Dados dos traductores, dar un traductor tal que la
-- funcion String -> String que denota el resultado, sea
-- justo la composicion de las funciones de cada
-- uno de los parametros.
comp :: Traductor qq1 -> Traductor qq2 ->
        Traductor (qq1, qq2)
comp (f1, g1, q1) (f2, g2, q2) = (f, g, q) where
        f = \(q1', q2') c -> (fAst f1 q1' (g2 q2' c), f2 q2' c)
        g = \(q1', q2') c -> gAst f1 g1 q1' (g2 q2' c)
        q = (q1, q2)

-- Dado un traductor, dar la cadena infinita que resulta de
-- procesar una lista infinita de "a"s.
salidaAes :: Traductor q -> String
salidaAes (f, g, q0) = gAst f g q0 (repeat 'a')

-- Decidir si es posible que el traductor recibido como primer
-- parametro genere la salida dada como segundo parametro.
salidaPosible ::  Traductor q -> String -> Bool
salidaPosible t w = elem w [salida | n <- [0..(length w)], salida <- salidasParaEntradasLongitudN t n]

-- Dado un traductor y un numero n, devuelve la lista que resulta
-- de aplicar el traductor a todos los numeros de n cifras.
salidasParaEntradasLongitudN ::  Traductor q -> Int -> [String]
salidasParaEntradasLongitudN t n = map (aplicando t) (entradasLongitudN n)

-- Dado un n devuelve todas las cadenas compuestas por numeros de longitud n.
entradasLongitudN ::  Int -> [String]
entradasLongitudN n = map numeroAString [desde..hasta] where
                        desde = 10^n
                        hasta = desde*2-1

-- Devuelve la representacion serializada para un numero quitando el primer "1"
-- que ese usado como prefijo auxiliar para poder generar cadenas como "0000".
numeroAString :: Int -> String
numeroAString x = drop 1 (show x)
 
